module LLVM.Parser.Record.BlockInfo where

import LLVM.Util
import LLVM.Parser.Record.Record
import LLVM.Parser.Record.Struct
import LLVM.Parser.Bits.Struct

import Data.Map as M

import Data.Char
import Control.Monad
import Data.Maybe(catMaybes)

type NameBindings = M.Map Integer String

data BlockInfo = BlockInfo { sbinds :: [AbbreviationDef], name :: String, nbinds :: NameBindings } deriving Show
data BlockInfoBlock = BlockInfoBlock (M.Map Int BlockInfo) deriving Show

infoBinds :: [AbbreviationDef]
infoBinds = []
-- is it really so?

-- little wonder :
-- it seems like all shit in BlockInfo is unabbreviated, with `code' defining it's val

blockInfoInfo :: BlockInfo
blockInfoInfo = BlockInfo infoBinds "Information block" M.empty

data SetBID = SetBID { sbidVal :: Integer } deriving Show
data SetBlockName = SetBlockName { sbnVal :: String } deriving Show
data SetRecordName = SetRecordName { desID :: Integer, srnVal :: String } deriving Show

putRecordName :: SetRecordName -> NameBindings -> NameBindings
putRecordName rn = M.insert (fromInteger $ desID rn) (srnVal rn)

isSetBID :: RawRecord -> Bool
isSetBID rec = case (getCode rec) of
                    Just 1 -> True
                    _ -> False

isBlockName :: RawRecord -> Bool
isBlockName rec = case (getCode rec) of
                    Just 2 -> True
                    _ -> False

isRecordName :: RawRecord -> Bool
isRecordName rec = case (getCode rec) of
                    Just 3 -> True
                    _ -> False

instance RecordType SetBID where
        fromRawRecord rr = case (flattenRecord rr) of
                                RawRecord _ (IntVal 1:IntVal id:_) -> Just $ SetBID id
                                _ -> Nothing

instance RecordType SetBlockName where
        fromRawRecord rr = case (recordAsList rr) of
                                (_:2:mes) -> Just $ SetBlockName $ Prelude.map (chr . fromIntegral) mes
                                _ -> Nothing

instance RecordType SetRecordName where
        fromRawRecord rr = case (recordAsList rr) of
                                (_:3:id:mes) -> Just $ SetRecordName id $ Prelude.map (chr . fromIntegral) mes
                                _ -> Nothing

convSingleInfo :: [RawRecord] -> Maybe BlockInfo
convSingleInfo rs =
        let rec [] ret = Just ret
            rec (rh:rt) ret
                | isBlockName rh =
                        case (fromRawRecord rh) of
                                (Just (SetBlockName bname)) -> rec rt ret{name = bname}
                                Nothing -> Nothing
                | isRecordName rh =
                        case (fromRawRecord rh) of
                                (Just (SetRecordName ix rname)) -> rec rt ret{nbinds = M.insert ix rname (nbinds ret)}
                                Nothing -> Nothing
                | isAbbrDefinition rh =
                        case (fromRawRecord rh) of
                                (Just abbr) -> rec rt ret{sbinds = (sbinds ret) `snoc` abbr }
                                Nothing -> Nothing
                | otherwise = rec rt ret
        in
        rec rs $ BlockInfo [] [] M.empty

instance BlockType BlockInfoBlock where
        fromRawBlock (RawBlock (BlockHeader 0 _ _) vs) =
                Just $ BlockInfoBlock $ M.fromList $ catMaybes $ Prelude.map makeInfo $ cutPieces cleas -- `debug` (show $ cutPieces cleas)
                where
                emptyBI = BlockInfo [] [] M.empty
                fromData (Sub _) = Nothing
                fromData (Data x) = Just x
                cleas = catMaybes $ Prelude.map fromData vs -- `debug` show vs
                cutPiece [] = ([],[])
                cutPiece (v:vs) | isSetBID v = let (before,after) = Prelude.span (not . isSetBID) vs in
                                               (v:before,after)--`debug` (show (v:before) ++ "\nx\n" ++ show after)
                                | otherwise = Prelude.span (not . isSetBID) (v:vs)
                cutPieces [] = []
                cutPieces lst = let cs = cutPiece lst in
                                [fst cs] ++ cutPieces (snd cs)
                makeInfo (n:lst) | isSetBID n = case (fromRawRecord n) of
                                                   Just (SetBID i) -> case (convSingleInfo lst) of
                                                                           Just inf -> Just (fromIntegral i,inf)
                                                                           Nothing -> Nothing
                                                   Nothing -> Nothing
                makeInfo _ = Nothing


--                conv [] (id,bi) res = M.insert id bi res
--                conv ((Sub _):vs) cur res = conv vs cur res-- all subblocks are skipped (ac. to LLVM)
--                conv ((Data v):vs) (id,bi) res | isSetBID v = conv vs (sbidVal $ fromRawRecord v,emptyBI) $ M.insert id bi res
--                                               | isBlockName v = conv vs (id,bi{name = sbnVal $ fromRawRecord v}) res
--                                               | isRecordName v = conv vs (id,bi{nbinds = putRecordName (fromRawRecord v) $ nbinds bi}) res
--                                               | isAbbrDefinition v = conv vs (id,bi{sbinds = sbinds bi `L.snoc` fromRawRecord v}) res
--
        fromRawBlock _ = Nothing

